home *** CD-ROM | disk | FTP | other *** search
/ Windows Expert / Windows Expert.iso / others / cwask.zip / ASK.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-06  |  3KB  |  114 lines
  1. unit mycommonprogram ask;
  2. uses wintypes,winprocs,wobjects,strings,commdlg;       
  3. type 
  4.     FileOpenHookProc = function (hDlg : HWnd; Message : word; wParam : word; lParam : longint) : word;
  5. var
  6.     hTempBitmap : hBitMap;
  7.     gbMonochrome : boolean;
  8.     ghDlgBrush    : hBrush;
  9.     lpfnFileOpenHook : ^FileOpenHookProc;
  10.     TheDC : HDC;
  11. {$r ask.res}
  12. {$f+}
  13. function FileOpenHook(hDlg : HWnd; Message : word; wParam : word; lParam : longint) : word;export;
  14. {$f-}
  15. var ret : word;
  16. begin
  17.     ret := word(false);
  18.     case Message of
  19.         WM_INITDIALOG:    begin
  20.                             ret := word(true);
  21.                         end;
  22.  
  23.         WM_CTLCOLOR:    begin
  24.                             if (gbMonochrome=true) or  (ghDlgBrush=0) then
  25.                                 FileOpenHook := word(false)
  26.                             else
  27.                             begin
  28.                                 if (HIWORD(lParam) = CTLCOLOR_LISTBOX) or (HIWORD(lParam) = CTLCOLOR_EDIT) then
  29.                                     ret := word(false) {Don't mess with the listboxes}
  30.                                 else
  31.                                 begin
  32.                                     if HIWORD(lParam) = CTLCOLOR_DLG then
  33.                                         UnrealizeObject(ghDlgBrush);  
  34.                                     SelectObject(HDC(wParam), ghDlgBrush);
  35.                                     if (HIWORD(lParam) = CTLCOLOR_DLG) then
  36.                                         SetBrushOrg(HDC(wParam), 0 , 0);
  37.                                     SetBkMode(HDC(wParam), TRANSPARENT);
  38.                                     ret := ghDlgBrush;
  39.                                 end;
  40.                             end;
  41.                         end;
  42.     end;
  43.     FileOpenHook := ret;
  44. end;
  45.  
  46. procedure CMFileOpen;
  47. var
  48.     OFN : TOpenFileName;
  49.     szFilter : array[0..50] of char;
  50.     szFileName,
  51.     szDirName,
  52.     szCommand,
  53.     szFile,szFileTitle:Array[0..512] of Char;
  54.     szFileDir : array[0..512] of Char;
  55.     chReplace : Char;
  56.     P:PChar;
  57.     cbString,i : integer;
  58. begin
  59.     StrCopy(szFilter,'Codewright Init (cw*.ini)');
  60.     StrCopy(@szFilter[StrLen(szFilter)+1],'cw*.ini');
  61.     szFilter[StrLen(szFilter)+9] := chr(0);
  62.     GetProfileString('CViewAsk','LastDir',chr(0),szFileDir,512);
  63.     StrCopy(szFileName,'cw*.ini');
  64.     OFN.lStructSize := sizeof(TOpenFileName);
  65.     OFN.hWndOwner := 0;
  66.     OFN.lpStrFilter := @szFilter;
  67.     OFN.lpStrCustomFilter := nil;
  68.     OFN.nMaxCustFilter := 0;
  69.     OFN.nFilterIndex := LongInt(1);
  70.     OFN.lpStrFile := szFileName;
  71.     OFN.nMaxFile := 255;
  72.     OFN.lpstrfileTitle := szFileTitle;
  73.     OFN.nMaxFileTitle := sizeof(szFileTitle);
  74.     OFN.lpstrInitialDir := szFileDir;
  75.     OFN.lpStrTitle := 'Select default Initialisation File';
  76.     OFN.flags := OFN_FILEMUSTEXIST+OFN_HIDEREADONLY+OFN_ENABLEHOOK;
  77.     OFN.nFileOffset := 0;
  78.     OFN.nFileExtension := 0;
  79.     OFN.lpstrDefext := 'ini';
  80.     OFN.lpfnHook := FileOpenHookProc(lpfnFileOpenHook);
  81.     if GetOpenFileName(OFN) and (StrLen(szFileName) > 0) then
  82.     begin
  83.         StrLCopy(szFileDir,szFileName,OFN.nFileOffset-1);
  84.         WriteProfileString('CViewAsk','LastDir',szFileDir);
  85.         StrCopy(szCommand,'CW /C ');
  86.         StrCat(szCommand,szFileName);
  87.         WinExec(szCommand,SW_SHOWNORMAL);
  88.     end;
  89. end;
  90. begin
  91.     lpfnFileOpenHook := MakeProcInstance(@FileOpenHook, hInstance);
  92.     TheDC := GetDC(0);
  93.     gbMonochrome := (2 = GetDeviceCaps(TheDC, NUMCOLORS));  { Monochrome!}
  94.     ReleaseDC(0, TheDC);
  95.     if not gbMonochrome then
  96.     begin
  97.         hTempBitmap:=LoadBitmap(hInstance, MAKEINTRESOURCE(1));
  98.         if hTempBitmap <> 0 then
  99.         begin
  100.             ghDlgBrush := CreatePatternBrush(hTempBitmap);
  101.             DeleteObject (hTempBitmap);
  102.         end;
  103.     end;
  104.     cmFileOpen;
  105.     if ghDlgBrush <> 0
  106.     then
  107.         DeleteObject(ghDlgBrush);
  108.     if lpfnFileOpenHook <> Nil then
  109.         FreeProcInstance(lpfnFileOpenHook);
  110. end.
  111.     
  112.     
  113.  
  114.